home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1994 November / Cd Ware (Nro. 2) - Epimundo.iso / DOS / UD / CRUSH.ZIP / CR081.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-06-01  |  10.7 KB  |  220 lines
  1. (*
  2.     CRUSH 0.81  -  Public Release
  3.     Designed and created by Bill Davidson
  4.  
  5. NOTE : Please view the documentation. This program will not execute
  6.        properly without a preset file name.
  7.  
  8.  This is Freeware. Please distribute.
  9.  
  10. *)
  11.  
  12. uses dos, crt;             { Standard procedure that I always add }
  13.  
  14.  
  15.  const VIIImax = 100;
  16.       VIImax = 100;
  17.       VImax = 100;
  18.       Vmax = 100;          { Defining the array limits }
  19.       IVmax = 100;
  20.       IIImax = 100;
  21.       theoffset = 145;
  22.  
  23. type  VIIIarray = array[1..VIIImax] of string[8];
  24.       VIIarray = array[1..VIImax] of string[7];
  25.       VIarray = array[1..VImax] of string[6];
  26.       Varray = array[1..Vmax] of string[5];    { Defining the arrays }
  27.       IVarray = array[1..IVmax] of string[4];
  28.       IIIarray = array[1..IIImax] of string[3];
  29.       chrarray = array[1..6] of char;
  30.  
  31. const
  32.   VIIIlist: VIIIarray = ('        ',' of the ','@       ','--------',' in the ',' pointer','tion of ',' to the ','tructure',
  33.                         'structur','@@~     ','ing the ',' structu','haracter','e of the','lgorithm','characte',' process',
  34.                         'that the',' charact',' that th','@@      ',' program','compress','s of the','rocessor','language',
  35.                         'pointers','algorith','program ',' languag',' can be ',' for the','for the ','ation of','function',
  36.                         ' compres','epresent','@Figure ',' on the ','hat the ',' algorit','represen','entation','mplement',
  37.                         'and the ','ormation','formatio',' the pro',' recursi',' functio',' and the','ubprogra',' represe',
  38.                         'subprogr','ion of t','implemen','ompressi','n of the','on of th','nformati','________','ocessor ',
  39.                         ' example','ructures',' subprog','rom the ',' from th','from the','t of the','with the','pression',
  40.                         'of the s',' impleme','@@@@@@@@',' with th','position','variable','ould be ',' number ','mpressio',
  41.                         'pointer ','nstructi','ictionar','omponent',' is the ','dictiona','ctionary','putation','consider',
  42.                         'componen','processo','ointers ','ed in th','ith the ','computat','mputatio','umber of','truction',
  43.                         'database');
  44.  
  45.   VIIlist: VIIarray = ('       ',' of the','of the ','@      ','_______','in the ',' in the',' which ','to the ',' to the',
  46.                        'program','ion of ','pointer','tion of',' pointe','ing the','tructur','ructure','ng the ','@@     ',
  47.                        '@@~    ','@~     ','s that ','e of th',' the co','process','present','at the ','aracter','lgorith',
  48.                        'gorithm','anguage','and the','that th','ompress',' the st','hat the','can be ','s of th',' that t',
  49.                        'e that ',' string','ations ','Figure ','rogram ','or the ','for the',' for th',' scheme',' can be',
  50.                        'on the ','ointers',' the pr','ocessor','nd the ',' follow','@Figure',' on the','ation o',' number',
  51.                        ' to be ',' and th','unction',' compre','recursi','the pro',' the re','ntation','nstruct','.  The ',
  52.                        'mplemen',' sub i%','plement',' other ','formati','tional ','tation ','rmation',' comput',' recurs',
  53.                        'n of th','es the ','rom the',' there ','with th','t of th','from th',' would ',' repres','on of t',
  54.                        '-------',' first ','example','@@@@@@@',' subpro','mpressi','.@This ',' from t','cessor ','ould be');
  55.  
  56.    VIlist: VIarray = ('      ',' of th',' that ','f the ',' the s','@     ','ation ',' the c','s the ','in the',' this ',
  57.                      'e the ',' in th','which ','______',' point','t the ',' with ','struct','to the',' which',' the p',
  58.                      'rogram','o the ',' to th','@@    ','ion of','tions ','ing th','tion o','pointe','on of ','ointer',
  59.                      '.@The ','rocess','ations','tation','s are ','at the','ction ',', and ','s that',' the f','s and ',
  60.                      'ructur',' proce','the co','ucture','r the ',' have ','~     ','g the ','d the ','@~    ','e of t',
  61.                      ' will ',' the t','nd the','string',' the l','and th','lement','ed by ','ed to ',' struc','presen',
  62.                      ' the a','ed in ','resent','e that',' the r','other ',' the r','other ',' the n',' sub i','hat th',
  63.                      'racter','gorith','orithm','that t','can be','the st','ection','  The ','or the',' other','nguage',
  64.                      'mpress','s of t',' the o','there ',' the e','for th','an be ','on the','Figure',' of a ','------',
  65.                      '. The ');
  66.  
  67.   Vlist: Varray = ('     ',' the ',' and ','tion ','ation','of th',' of t',' that','f the','that ','@    ','n the',' sub ',
  68.                    'ction','s of ',' for ','the s',' comp','s the',' are ','the c','e the','e of ','tions',' with','in th',
  69.                    't the','ing t',' this','this ','which','with ',' in t','point',' the@','inter','to th','hich ','_____',
  70.                    'the p','ther ','truct','o the','.@The','@The ',' to t','struc','@the ','here ','s to ','ion o','ions ',
  71.                    't of ','@and ','@@   ','ting ',' not ','ng th','ogram','ition','n of ','t is ','d the','on of','ement',
  72.                    ' from',' can ','from ','other','ointe',' cont','progr',' of a','s are',' one ','at th','ed in','ding ',
  73.                    'he co','e is ','r the','g the','proce','ocess','d to ',', and','ould ',' is a','cture','s and','the f',
  74.                    ', the','ing a','nd th',' have','s tha','and t','have ','will ',' The ');
  75.  
  76.   IVlist: IVarray = ('    ',' the','the ',' of ','tion','ing ','and ',' to ',' and',' is ','ion ',' in ','that','f th',' tha',
  77.                      'atio','hat ','of t','n th',' sub','@   ','s th',' for','e th','his ',' pro','ther',' com','for ',' be ',
  78.                      ' con','sub ','s of','he s','comp','The ','are ',' are','he c','t th','with','ent ','e of','ions',' thi',
  79.                      'e co','ment','.@Th','in t','ted ','inte','@the','nter','this','@The',' wit','ng t','ter ','here',' as ',
  80.                      'mple','o th','her ','ith ','pres','@and',' str','hich','ting','to t','oint',' not','d th','he p','the@',
  81.                      'ere ','ding','ring',' by ','s a ',' it ','____','ich ',' whi','s to','s in','cess','form','s an','t th',
  82.                      'is a','gram','ed t','ture','one ','t of',' poi','t is','----','oice');
  83.  
  84.   IIIlist: IIIarray = ('   ',' th','the','he ',' of','of ','ing','ion','is ','and','tio',' an','nd ',' in','ed ',' to','to ',
  85.                        'ng ',' co','er ','on ','es ',' a ','re ',' is','ent','in ','s a','e t','or ','ter',' re',' su','at ',
  86.                        's t','for',' be','ati','@@~','hat','tha','e s','e a','n t','al ','her','f t','res','pro','e c',' fo',
  87.                        ' pr','s o',' st','e o','as ','sub','.  ','all','en ','on ','con','are','ess','his','ly ','e i','The',
  88.                        'ch ',' no','@  ','t t','ith','omp','ons','int','nte','ll ',' ar','ere',' de','cti','be ','ver','nt ',
  89.                        'st ','d t','ers',' wi',' wh','str','e p','nce','ts ',' ma','ate','@th','thi','---','. T');
  90.  
  91.   chrlist: chrarray = (chr(1),chr(2),chr(3),chr(4),chr(5),chr(6));
  92.  
  93.    { Those arrays make up the dictionoary that I use to code with }
  94.  
  95. var
  96.  f, j : text;
  97.  s,s1 : string[255];
  98.  a1, v1 : integer;
  99.  c1 : string[2];
  100.  find1,find2,find3 : integer;
  101.  length1 : integer;
  102.  chra : integer;
  103.  label
  104.   skipdouble,startloop,
  105.   skip8,skip7,skip6,skip5,skip4,skip3,start8,start7,start6,start5,start4,start3,end1;
  106.  
  107. begin
  108. assign(f,'q.q');         { File to compress }
  109. reset(f);                { Open the file to compress for reading}
  110. assign(j,'w.w');         { Output file }
  111. rewrite(j);              { Open  the output file for writing }
  112. while not eof(f) do      { if we have not reached the end of the file... }
  113.  begin
  114.  
  115.  readln(f,s);            { Read the current line }
  116.  length1 := length(s);
  117.  for chra := 249 to 254 do          { Trying to find header characters }
  118.   begin
  119.    a1 := 0;              { pointer to the string position }
  120.    startloop:
  121.     a1 := a1 + 1;        { Advance pointer }
  122.     if a1 > length1 then goto end1; { Check to see if we have reached the
  123.                                       end of the line }
  124.     begin
  125.      if chr(chra) = s[a1]  then     { If current scanned character equals
  126.                                       a header character then... }
  127.       begin
  128.       insert(chr(chra),s,a1);       { Insert another header character with
  129.                                       it }
  130.       a1 := a1 + 1;                 { Advance pointer past the doubled
  131.                                       character }
  132.       length1 := length(s);
  133.       end;
  134.      goto startloop;
  135.    end;
  136.   end1:
  137.   end;
  138.  
  139.  for v1 := 1 to VIIImax do          { Using the 8 letter array }
  140.   begin
  141.    start8:
  142.    a1 := pos(VIIIlist[v1],s);       { Searching the line for each of the
  143.                                       strings in the array and moves the
  144.                                       pointer there }
  145.    if a1 = 0 then goto skip8;       { Skip this if it doesn't find any }
  146.    delete(s,a1,length(VIIIlist[v1]));  { Delete the string at the pointer }
  147.    c1 := chr(249) + chr(v1 + theoffset); { The header character and a code
  148.                                            character for the string }
  149.    insert(c1,s,a1);      { Insert the 2 characters }
  150.    goto start8;
  151.   skip8:
  152.   end;
  153.  
  154. { It's the same for 7 to 3 }
  155.  
  156.  for v1 := 1 to VIImax do
  157.   begin
  158.    start7:
  159.    a1 := pos(VIIlist[v1],s);
  160.    if a1 = 0 then goto skip7;
  161.    delete(s,a1,length(VIIlist[v1]));
  162.    c1 := chr(250) + chr(v1 + theoffset);
  163.    insert(c1,s,a1);
  164.    goto start7;
  165.   skip7:
  166.   end;
  167.  
  168.  for v1 := 1 to VImax do
  169.   begin
  170.    start6:
  171.    a1 := pos(VIlist[v1],s);
  172.    if a1 = 0 then goto skip6;
  173.    delete(s,a1,length(VIlist[v1]));
  174.    c1 := chr(251) + chr(v1 + theoffset);
  175.    insert(c1,s,a1);
  176.    goto start6;
  177.   skip6:
  178.   end;
  179.  
  180.  for v1 := 1 to Vmax do
  181.   begin
  182.    start5:
  183.    a1 := pos(Vlist[v1],s);
  184.    if a1 = 0 then goto skip5;
  185.    delete(s,a1,length(Vlist[v1]));
  186.    c1 := chr(252) + chr(v1 + theoffset);
  187.    insert(c1,s,a1);
  188.    goto start5;
  189.   skip5:
  190.   end;
  191.  
  192.  for v1 := 1 to IVmax do
  193.   begin
  194.    start4:
  195.    a1 := pos(IVlist[v1],s);
  196.    if a1 = 0 then goto skip4;
  197.    delete(s,a1,length(IVlist[v1]));
  198.    c1 := chr(253) + chr(v1 + theoffset);
  199.    insert(c1,s,a1);
  200.    goto start4;
  201.   skip4:
  202.   end;
  203.  
  204.  for v1 := 1 to IIImax do
  205.   begin
  206.    start3:
  207.    a1 := pos(IIIlist[v1],s);
  208.    if a1 = 0 then goto skip3;
  209.    delete(s,a1,length(IIIlist[v1]));
  210.    c1 := chr(254) + chr(v1 + theoffset);
  211.    insert(c1,s,a1);
  212.    goto start3;
  213.   skip3:
  214.   end;
  215. length1 := length(s);
  216. writeln(j,s);            { Write the modified string to the output file }
  217. end;
  218. close(j);                { Save 'j' }
  219. end.
  220.